home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / avoid.el < prev    next >
Lisp/Scheme  |  1993-11-23  |  9KB  |  235 lines
  1. ;;; avoid.el -- make mouse pointer stay out of the way of editing.
  2.  
  3. ;;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Boris Goldowsky <boris@cs.rochester.edu>
  6. ;; Keywords: mouse
  7. ;; Version: 1.10
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Commentary:
  26. ;;;
  27. ;;; For those who are annoyed by the mouse pointer obscuring text,
  28. ;;; this mode moves the mouse pointer - either just a little out of
  29. ;;; the way, or all the way to the corner of the frame. 
  30. ;;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
  31. ;;; To set up permanently, put this file on your load-path and put the
  32. ;;; following in your .emacs: 
  33. ;;;
  34. ;;; (cond (window-system
  35. ;;;        (require 'avoid)
  36. ;;;        (mouse-avoidance-mode 'cat-and-mouse)))
  37. ;;;
  38. ;;; The 'animate can be 'jump or 'banish or 'protean if you prefer.
  39. ;;;
  40. ;;; For added silliness, make the animatee animate...
  41. ;;; put something similar to the following into your .emacs:
  42. ;;;
  43. ;;; (cond (window-system
  44. ;;;       (setq x-pointer-shape 
  45. ;;;         (eval (nth (random 4)
  46. ;;;            '(x-pointer-man x-pointer-spider
  47. ;;;              x-pointer-gobbler x-pointer-gumby))))
  48. ;;;       (set-mouse-color (cdr (assoc 'mouse-color (frame-parameters))))))
  49. ;;;
  50. ;;; For completely random pointer shape, replace the setq above with:
  51. ;;; (setq x-pointer-shape (mouse-avoidance-random-shape))
  52. ;;; 
  53. ;;; Bugs & Warnings:
  54. ;;;
  55. ;;; - THIS CODE IS FOR USE WITH FSF EMACS 19.21 or later.
  56. ;;;   It can cause earlier versions of emacs to crash, due to a bug in the
  57. ;;;   mouse code. 
  58. ;;;
  59. ;;; - Using this code does slow emacs down.  "banish" mode shouldn't
  60. ;;;   ever be too bad though, and on my workstation even "animate" doesn't
  61. ;;;   seem to have a noticable effect.
  62. ;;;
  63. ;;; - There are some situations where it doesn't do what you expect,
  64. ;;;   notably when there are long wrapped lines in the buffer.  Since
  65. ;;;   there is no low-level command for finding point's position
  66. ;;;   on the screen, it can fail to move the pointer when on such a line.
  67.  
  68. ;;; Credits:
  69. ;;; This code was helped by all those who contributed suggestions, fixes, and 
  70. ;;; additions:
  71. ;;; Joe Harrington (and his advisor), for the original inspiration
  72. ;;; Ken Manheimer, for dreaming up the Protean mode
  73. ;;; Richard Stallman, for the awful cat-and-mouse pun, among other things
  74. ;;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris,
  75. ;;; Simon Marshall, and M.S. Ashton, for their feedback.
  76. ;;;
  77. ;;; Code:
  78.  
  79. (provide 'avoid)
  80.  
  81. (defvar mouse-avoidance-mode nil
  82.   "Value is t or a symbol if the mouse pointer should avoid the cursor.
  83. See function mouse-avoidance-mode for possible values.  Changing this
  84. variable is NOT the recommended way to change modes; use the function 
  85. instead.")
  86.  
  87. (defvar mouse-avoidance-nudge-dist 4
  88.   "*Average distance that mouse will be moved when approached by cursor.
  89. Only applies in mode-avoidance-modes `animate' and `jump'.")
  90.  
  91. (defvar mouse-avoidance-nudge-var 3
  92.   "*Variability of mouse-avoidance-nudge-dist (which see).")
  93.  
  94. (defvar mouse-avoidance-animation-delay .01
  95.   "Delay between animation steps, in seconds.")
  96.  
  97. (defvar mouse-avoidance-threshhold 5
  98.   "*Mouse-pointer's flight distance.
  99. If the cursor gets closer than this, the mouse pointer will move away.
  100. Only applies in mouse-avoidance-modes `animate' and `jump'.")
  101.  
  102. ;; Internal variables for mouse-avoidance-random-shape
  103. (defvar mouse-avoidance-pointer-shapes nil)
  104. (defvar mouse-avoidance-n-pointer-shapes 0)
  105.  
  106. ;;; Functions:
  107.  
  108. (defun mouse-avoidance-too-close-p ()
  109.   ;;  Return t if mouse pointer and point cursor are too close.
  110.   ;; Acceptable distance is defined by mouse-avoidance-threshhold.
  111.   (let ((mouse (mouse-position)))
  112.     (and (car (cdr mouse))
  113.      (< (abs (- (car (cdr mouse)) (current-column)))
  114.         mouse-avoidance-threshhold)
  115.      (< (abs (- (cdr (cdr mouse)) 
  116.             (+ (car (cdr (window-edges)))
  117.                (count-lines (window-start) (point)))))
  118.         mouse-avoidance-threshhold))))
  119.  
  120. (defun mouse-avoidance-banish-mouse ()
  121.   ;; Put the mouse pointer in the upper-right corner of the current frame.
  122.   (set-mouse-position (selected-frame) (1- (frame-width)) 0))
  123.  
  124. (defun mouse-avoidance-nudge-mouse () 
  125.   ;; Push the mouse a little way away, possibly animating the move
  126.   (let* ((cur (mouse-position))
  127.      (deltax (* (+ mouse-avoidance-nudge-dist 
  128.                (random mouse-avoidance-nudge-var))
  129.             (if (zerop (random 2)) 1 -1)))
  130.      (deltay (* (+ mouse-avoidance-nudge-dist
  131.                (random mouse-avoidance-nudge-var))
  132.             (if (zerop (random 2)) 1 -1))))
  133.     (if (or (eq mouse-avoidance-mode 'animate) 
  134.         (eq mouse-avoidance-mode 'proteus))
  135.     (let ((i 0.0)
  136.           (color (cdr (assoc 'mouse-color (frame-parameters)))))
  137.       (while (<= i 1)
  138.         (set-mouse-position 
  139.          (car cur) 
  140.          (mod (+ (car (cdr cur)) (round (* i deltax))) (window-width))
  141.          (mod (+ (cdr (cdr cur)) (round (* i deltay))) (window-height)))
  142.         (setq i (+ i (/ 1.0 mouse-avoidance-nudge-dist)))
  143.         (if (eq mouse-avoidance-mode 'proteus)
  144.         (progn
  145.           (setq x-pointer-shape (mouse-avoidance-random-shape))
  146.           (set-mouse-color color)))
  147.         (sit-for mouse-avoidance-animation-delay)))
  148.       (set-mouse-position 
  149.        (car cur)
  150.        (mod (+ (car (cdr cur)) deltax) (window-width))
  151.        (mod (+ (cdr (cdr cur)) deltay) (window-height))))))
  152.  
  153. (defun mouse-avoidance-random-shape ()
  154.   "Return a random cursor shape.
  155. This assumes that any variable whose name begins with x-pointer- and
  156. has an integer value is a valid cursor shape.  You might want to
  157. redefine this function to suit your own tastes."
  158.   (if (null mouse-avoidance-pointer-shapes)
  159.       (progn
  160.     (setq mouse-avoidance-pointer-shapes
  161.           (mapcar '(lambda (x) (symbol-value (intern x)))
  162.               (all-completions "x-pointer-" obarray
  163.                        '(lambda (x) 
  164.                       (and (boundp x)
  165.                            (integerp (symbol-value x)))))))
  166.     (setq mouse-avoidance-n-pointer-shapes 
  167.           (length mouse-avoidance-pointer-shapes))))
  168.   (nth (random mouse-avoidance-n-pointer-shapes)
  169.        mouse-avoidance-pointer-shapes))
  170.  
  171. (defun mouse-avoidance-simple-hook ()
  172.   (if (and (mouse-avoidance-keyboard-command (this-command-keys)))
  173.       (mouse-avoidance-banish-mouse)))
  174.  
  175. (defun mouse-avoidance-fancy-hook ()
  176.   (if (and (mouse-avoidance-keyboard-command (this-command-keys))
  177.        (mouse-avoidance-too-close-p))
  178.       (mouse-avoidance-nudge-mouse)))
  179.  
  180. (defun mouse-avoidance-keyboard-command (key)
  181.   "Return t if the KEYSEQENCE is composed of keyboard events only.
  182. Returns nil if there are any lists in the key sequence."
  183.   (cond ((null key) nil)        ; Null event seems to be
  184.                     ; returned occasionally.
  185.     ((not (vectorp key)) t)        ; Strings are keyboard events.
  186.     ((catch 'done
  187.        (let ((i 0)
  188.          (l (length key)))
  189.          (while (< i l)
  190.            (if (listp (aref key i))
  191.            (throw 'done nil))
  192.            (setq i (1+ i))))
  193.        t))))
  194.  
  195. (defun mouse-avoidance-mode (&optional mode)
  196.   "Set cursor avoidance mode to MODE.
  197. MODE should be one of the symbols `banish', `jump', `animate',
  198. `cat-and-mouse', or `none'.  `Animate' is the same as `cat-and-mouse'.
  199. If MODE is nil, toggle mouse avoidance.  Positive numbers and
  200. symbols other than the above are treated as equivalent to `banish';
  201. negative numbers and `-' are equivalent to `none'."
  202.   (interactive
  203.    (list (intern (completing-read
  204.           "Select cursor avoidance technique (SPACE for list): "
  205.           '(("banish") ("jump") ("animate") ("cat-and-mouse") 
  206.             ("proteus") ("none"))
  207.           nil t))))
  208.   (if (eq mode 'cat-and-mouse)
  209.       (setq mode 'animate))
  210.   (setq post-command-hook
  211.     (delete 'mouse-avoidance-simple-hook (append post-command-hook nil)))
  212.   (setq post-command-hook
  213.     (delete 'mouse-avoidance-fancy-hook (append post-command-hook nil)))
  214.   (cond    ((eq mode 'none)
  215.      (setq mouse-avoidance-mode nil))
  216.     ((or (eq mode 'jump)
  217.          (eq mode 'animate)
  218.          (eq mode 'proteus))
  219.      (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook)
  220.      (setq mouse-avoidance-mode mode))
  221.     ((or (eq mode 'banish) 
  222.          (eq mode t)
  223.          (and (null mode) (null mouse-avoidance-mode))
  224.          (and mode (> (prefix-numeric-value mode) 0)))
  225.      (add-hook 'post-command-hook 'mouse-avoidance-simple-hook)
  226.      (setq mouse-avoidance-mode 'banish))
  227.     (t (setq mouse-avoidance-mode nil))))
  228.  
  229. (or (assq 'mouse-avoidance-mode minor-mode-alist)
  230.     (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid")
  231.                  minor-mode-alist)))
  232.  
  233. ;;; End of avoid.el
  234.  
  235.